home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / BINSRC.f < prev    next >
Encoding:
Text File  |  1992-07-31  |  1.1 KB  |  41 lines
  1.       SUBROUTINE BINSRC(KELEM,KLIST,NLIST,IPOS,LAST)
  2. *-----------------------------------------------------------------------
  3. *   
  4. *---Purpose:    finds number in sorted list (ascending) 
  5. *               with binary search. 
  6. *   
  7. *---Input   
  8. *   KELEM           number to be looked up  
  9. *   KLIST           table   
  10. *   NLIST           length of table 
  11. *   
  12. *---Output  
  13. *   IPOS            = 0: name not in table  
  14. *                   > 0: position in table  
  15. *   LAST            for IPOS=0, position behind which number belongs
  16. *   
  17. *---Author :    HG      date: 17.5.79     last revision: 20.6.84
  18. *   
  19. *-----------------------------------------------------------------------
  20.       DIMENSION KLIST(*)
  21.       IPOS=0
  22.       LAST=0
  23.       N=NLIST   
  24.       IF(N.GT.0)  THEN  
  25.          KPOS=0 
  26.    10    M=(N+1)/2  
  27.          LAST=KPOS+M
  28.          IF (KELEM.LT.KLIST(LAST))  THEN
  29.             N=M 
  30.             LAST=LAST-1 
  31.             IF (N.GT.1) GOTO 10 
  32.          ELSEIF (KELEM.GT.KLIST(LAST))  THEN
  33.             KPOS=LAST   
  34.             N=N-M   
  35.             IF (N.GT.0) GOTO 10 
  36.          ELSE   
  37.             IPOS=LAST   
  38.          ENDIF  
  39.       ENDIF 
  40.       END   
  41.